home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE16 / RTTI / OrdForm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-30  |  4.9 KB  |  186 lines
  1. unit OrdForm;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, TypInfo;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Listbox1: TListBox;
  12.     ListBox2: TListBox;
  13.     Label1: TLabel;
  14.     procedure Listbox1Click(Sender: TObject);
  15.     procedure FormCreate(Sender: TObject);
  16.   private
  17.     { Private declarations }
  18.   public
  19.     procedure AddType (pti: PTypeInfo);
  20.     procedure AddToList (S: String);
  21.   end;
  22.  
  23.   procedure ShowOrdinal (pti: PTypeInfo; sList: TStrings);
  24.   procedure ListEnum (pti: PTypeInfo; sList: TStrings);
  25.  
  26. var
  27.   Form1: TForm1;
  28.  
  29. implementation
  30.  
  31. {$R *.DFM}
  32.  
  33. procedure TForm1.Listbox1Click(Sender: TObject);
  34. var
  35.   pti: PTypeInfo;
  36. begin
  37.   pti := PTypeInfo (ListBox1.Items.Objects [
  38.     Listbox1.ItemIndex]);
  39.   ListBox2.Items.Clear;
  40.   ShowOrdinal (pti, ListBox2.Items);
  41.  
  42.   // special case: TColor
  43.   if ListBox1.Items [ListBox1.ItemIndex] = 'TColor' then
  44.   begin
  45.     ListBox2.Items.Add ('');
  46.     ListBox2.Items.Add ('Values...');
  47.     GetColorValues (AddToList);
  48.   end;
  49.  
  50.   // special case: TCursor
  51.   if ListBox1.Items [ListBox1.ItemIndex] = 'TCursor' then
  52.   begin
  53.     ListBox2.Items.Add ('');
  54.     ListBox2.Items.Add ('Values...');
  55.     GetCursorValues (AddToList);
  56.   end;
  57. end;
  58.  
  59. procedure TForm1.AddToList (S: String);
  60. begin
  61.   ListBox2.Items.Add (S);
  62. end;
  63.  
  64. // show RTTI information for ordinal types
  65. procedure ShowOrdinal (pti: PTypeInfo; sList: TStrings);
  66. var
  67.   ptd: PTypeData;
  68. begin
  69.   // protect against misuse
  70.   if not (pti^.Kind in [tkInteger, tkChar,
  71.       tkEnumeration, tkSet, tkWChar]) then
  72.     raise Exception.Create ('Invalid type information');
  73.  
  74.   // get a pointer to the TTypeData structure
  75.   ptd := GetTypeData (pti);
  76.  
  77.   // access the TTypeInfo structure
  78.   sList.Add ('Type Name: ' + pti^.Name);
  79.   sList.Add ('Type Kind: ' + GetEnumName (
  80.     TypeInfo (TTypeKind),
  81.     Integer (pti^.Kind)));
  82.  
  83.   // access the TTypeData structure
  84.   sList.Add ('Implement: ' + GetEnumName (
  85.     TypeInfo (TOrdType),
  86.     Integer (ptd^.OrdType)));
  87.  
  88.   // a set has no min and max
  89.   if pti^.Kind <> tkSet then
  90.   begin
  91.     sList.Add ('Min Value: ' + IntToStr (ptd^.MinValue));
  92.     sList.Add ('Max Value: ' + IntToStr (ptd^.MaxValue));
  93.   end;
  94.  
  95.   // add the enumeration base type
  96.   // and the list of the values
  97.   if pti^.Kind = tkEnumeration then
  98.   begin
  99.     sList.Add ('Base Type: ' + (ptd^.BaseType)^.Name);
  100.     sList.Add ('');
  101.     sList.Add ('Values...');
  102.     ListEnum (pti, sList);
  103.   end;
  104.  
  105.   // show RRTI info about set base type
  106.   if  pti^.Kind = tkSet then
  107.   begin
  108.     sList.Add ('');
  109.     sList.Add ('Set base type information...');
  110.     ShowOrdinal (ptd^.CompType, sList);
  111.   end;
  112. end;
  113.  
  114. procedure ListEnum (pti: PTypeInfo; sList: TStrings);
  115. var
  116.   I: Integer;
  117. begin
  118.   with GetTypeData(pti)^ do
  119.     for I := MinValue to MaxValue do
  120.       sList.Add ('  ' + IntToStr (I) + '. ' +
  121.         GetEnumName (pti, I));
  122. end;
  123.  
  124. procedure TForm1.AddType (pti: PTypeInfo);
  125. begin
  126.   ListBox1.Items.AddObject(pti^.Name, TObject (pti))
  127. end;
  128.  
  129. procedure TForm1.FormCreate(Sender: TObject);
  130. begin
  131.   AddType (TypeInfo (Boolean));
  132.   AddType (TypeInfo (Byte));
  133.   AddType (TypeInfo (Char));
  134.   AddType (TypeInfo (Integer));
  135.   AddType (TypeInfo (LongInt));
  136.   AddType (TypeInfo (ShortInt));
  137.   AddType (TypeInfo (SmallInt));
  138.   AddType (TypeInfo (WChar));
  139.   AddType (TypeInfo (Word));
  140.   AddType (TypeInfo (Cardinal));
  141.   AddType (TypeInfo (TAlignment));
  142.   AddType (TypeInfo (TComponentState));
  143.   AddType (TypeInfo (TComponentStyle));
  144.   AddType (TypeInfo (THelpContext));
  145.   AddType (TypeInfo (TOperation));
  146.   AddType (TypeInfo (TShiftState));
  147.   AddType (TypeInfo (TThreadPriority));
  148.   AddType (TypeInfo (TAlign));
  149.   AddType (TypeInfo (TControlState));
  150.   AddType (TypeInfo (TControlStyle));
  151.   AddType (TypeInfo (TCursor));
  152.   AddType (TypeInfo (TDragMode));
  153.   AddType (TypeInfo (TDragState));
  154.   AddType (TypeInfo (TImageType));
  155.   AddType (TypeInfo (TMouseButton));
  156.   AddType (TypeInfo (TResType));
  157.   AddType (TypeInfo (TTabOrder));
  158.   AddType (TypeInfo (TBorderIcons));
  159.   AddType (TypeInfo (TBorderStyle));
  160.   AddType (TypeInfo (TCloseAction));
  161.   AddType (TypeInfo (TFormBorderStyle));
  162.   AddType (TypeInfo (TFormStyle));
  163.   AddType (TypeInfo (TModalResult));
  164.   AddType (TypeInfo (TPosition));
  165.   AddType (TypeInfo (TPrintScale));
  166.   AddType (TypeInfo (TScrollBarInc));
  167.   AddType (TypeInfo (TScrollBarKind));
  168.   AddType (TypeInfo (TTileMode));
  169.   AddType (TypeInfo (TWindowState));
  170.   AddType (TypeInfo (TBrushStyle));
  171.   AddType (TypeInfo (TColor));
  172.   AddType (TypeInfo (TFillStyle));
  173.   AddType (TypeInfo (TFontPitch));
  174.   AddType (TypeInfo (TFontStyles));
  175.   AddType (TypeInfo (TPenMode));
  176.   AddType (TypeInfo (TPenStyle));
  177.   AddType (TypeInfo (TCheckBoxState));
  178.   AddType (TypeInfo (TComboBoxStyle));
  179.   AddType (TypeInfo (TEditCharCase));
  180.   AddType (TypeInfo (TListBoxStyle));
  181.   AddType (TypeInfo (TScrollCode));
  182.   AddType (TypeInfo (TScrollStyle));
  183. end;
  184.  
  185. end.
  186.